home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 020 / modula.arc / BANNER.MOD next >
Encoding:
Text File  |  1986-08-19  |  2.3 KB  |  115 lines
  1.  
  2. MODULE Banner;
  3.  
  4. (*  Banner.Mod
  5.     04/11/1986
  6.     John Tal
  7.  
  8.     Version of Banner.Mod  -  Prints Horizontal banners.
  9.  
  10.     Accesses Character Data in ROM at 0F000H:0FA6EH;
  11.  
  12.     Character Height & Width's are Adjustable
  13.  *)
  14.  
  15.  
  16.  
  17.  
  18. FROM Printer IMPORT OpenPrinter,ClosePrinter,PrintString,PrintLn;
  19. FROM InOut   IMPORT OpenInput,CloseInput,ReadCard,Done,Write,
  20.                     WriteCard,WriteLn,WriteString,ReadString;
  21. FROM SYSTEM  IMPORT ADDRESS,GETREG,AX,SWI,BYTE;
  22. FROM Strings IMPORT Concat,Length;
  23.  
  24.  
  25. CONST
  26.   wide = 132;
  27.  
  28. TYPE
  29.   mainc = ARRAY[1..8] OF ARRAY[1..wide] OF CHAR;
  30.   STRING = ARRAY[0..255] OF CHAR;
  31.  
  32. VAR
  33.   bytes : POINTER TO ARRAY[0..255] OF ARRAY[1..8] OF CHAR;
  34.   chars : mainc;
  35.   r,c : CARDINAL;
  36.   outstr : STRING;
  37.   cval,byte,a,msgl,sp1,i,height,width : CARDINAL;
  38.  
  39.  
  40. PROCEDURE Ptr(seg, off : CARDINAL) : ADDRESS;
  41. VAR
  42.   Result :
  43.     RECORD
  44.       CASE BOOLEAN OF
  45.         FALSE :
  46.           adr : ADDRESS;
  47.       | TRUE :
  48.           off, seg : CARDINAL;
  49.         END;
  50.       END;
  51. BEGIN
  52.   Result.off := off;
  53.   Result.seg := seg;
  54.   RETURN Result.adr;
  55. END Ptr;
  56.  
  57.  
  58. PROCEDURE power(x,n : CARDINAL) : CARDINAL;
  59. BEGIN
  60.    IF n=1  THEN
  61.      RETURN x;
  62.    ELSIF n <= 0 THEN
  63.      RETURN 1;
  64.    ELSE
  65.      RETURN (x * power(x,n-1));
  66.   END;
  67. END power;
  68.  
  69.  
  70. PROCEDURE BitOut ( offs,height,width : CARDINAL);
  71. VAR
  72.  showLine : STRING;
  73.  left,up,h,bite,w : CARDINAL;
  74.  pattern : BITSET;
  75.  BEGIN
  76.    FOR left := 1 TO 8 DO
  77.      showLine[0] := CHR(0);
  78.      FOR up := 8 TO 1 BY -1 DO
  79.        pattern := BITSET(ORD(bytes^[offs,up])) * BITSET(power(2,8-left));
  80.        bite := CARDINAL(pattern);
  81.        IF bite = 0  THEN
  82.            Write(' ');
  83.            FOR h := 1 TO height DO
  84.              Concat(showLine,' ',showLine);
  85.            END;
  86.          ELSE
  87.            Write('X');
  88.            FOR h := 1 TO height DO
  89.              Concat(showLine,'X',showLine);
  90.            END;
  91.        END;
  92.      END;
  93.      FOR w := 1 TO width DO
  94.         PrintString(showLine); PrintLn;
  95.      END;
  96.      WriteLn;
  97.    END;
  98. END BitOut;
  99.  
  100. BEGIN
  101.   bytes := Ptr(0F000H,0FA6EH);
  102.   height := 14; (* 14 *)
  103.   width := 4; (* 3 *)
  104.   WriteString('Banner> ');
  105.   ReadString(outstr);
  106.   WriteLn;
  107.   OpenPrinter;
  108.   FOR a := 0 TO Length(outstr)-1 DO
  109.     Write(outstr[a]); WriteLn;
  110.     i := ORD(outstr[a]);
  111.     BitOut(i,height,width);
  112.   END;
  113.   ClosePrinter;
  114. END Banner.
  115.